home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / wildcat / qwkhold1.zip / QWK2HOLD.WCC < prev    next >
Text File  |  1996-05-17  |  31KB  |  709 lines

  1. 'QWK_ASK.WCC by James Mardis  (FidoNet 1:322/746)  5/7/96
  2. '
  3. 'This program allows callers to turn on/off the QWK Prescan feature as
  4. 'well as download any existing QWK mail packets currently on hold.
  5. 'It is used with the companion programs LOGON2.WCC and QWK2MAKE.WCC.
  6. '
  7. 'You may Freely modify this program as long as you do NOT charge for
  8. 'it's use in this form or the modified form.  This program is in the
  9. 'public domain.  This program carries no Warranty, Guarantee whatsover.
  10. 'You use this program at your own risk.  The original Author shall NOT
  11. 'be held responsible for any damages whatsoever as to the result or use
  12. 'of this program.   After all, It is in the public Domain and is subject
  13. 'to change without the knowledge of the Author (James Mardis).
  14. '
  15. 'The configuration file, QWK2HOLD.CFG breaks down as follows:
  16. 'Line #1, Complete PathName where WCMAIL QWK stores mail packets,
  17. '         such as C:\WILDCAT\MAIL\QWK\
  18. '
  19. 'Line #2, File area number for QWK Mail that was choosen in the Makewild
  20. '         QWK Mail area.
  21. '
  22. 'Line #3, Complete PathName where QWK2 can store all user mail packets.
  23. '
  24. 'Line #4, Valid values are COMMENT(1) thru COMMENT(5) exactly as shown.
  25. '         The right and left parentheses around the number are
  26. '         manditory.
  27. '
  28. '         The actual value found in the user's COMMENT(?) field will
  29. '         contain either QWK2 ON  XX or QWK2 OFF XX where XX equals
  30. '         the number of mail packets that are currently in storage.
  31. '         The XX field must begin at character 10 in the comment field.
  32. '
  33. 'Line #5, Security Profile #1 to exclude from operating this program.
  34. '         I use this to bar NEWUSER from this program
  35. '         while allowing them access to other WCX programs.
  36. '         If not used set it to NO SEC1.
  37. '
  38. 'Line #6, Security Profile #2 to exclude from operating this program.
  39. '         If not used set it at NO SEC2.
  40. '
  41. 'Line #7  Maximum number of QWK packets a caller can have waiting for pickup.
  42. '         Valid values are 1 to 26.
  43. '
  44. 'Line #8  Maximum number of days to keep stored QWK packets.
  45. '         Valid values are 1 to 365.
  46. '
  47. 'Line #9  Maximum allowed storage space for user packets in bytes, but
  48. '         a minimum of 1 packet is allowed regardless of this value.
  49. '         Valid values are 1 to 2147483647, this is in bytes like
  50. '         what you see when listing a DOS directory from DOS.
  51. '
  52. 'Line #10 Conference number where user messages are to be sent.
  53. '         Messages will be sent with the Private flag turned on.
  54. '
  55. 'Line #11 Prompt colors normal for Text and Background, leave off @ symbols.
  56. '         Default two character code is 0E.
  57. '
  58. 'Line #12 Prompt colors normal for Highlighted Text.
  59. '         Default two character code is 0B.
  60. '
  61. 'Line #13 Prompt colors normal for Packet size and elsewhere.
  62. '         Default two character code is 0C.
  63. '
  64. 'Line #14 Prompt colors normal for warning messages.
  65. '         Default two character code is 0E.
  66. '
  67. 'Line #15 Path to inbound mail flag,  Where to look for QWK2MA?.FLG.
  68. '
  69. 'Line #16 Text to display when Mail Flag #1 is found.
  70. '
  71. 'Line #17 Text to display when Mail Flag #2 is found.
  72. '
  73. 'Line #18 Text to display when Mail Flag #3 is found.
  74. '
  75. 'Line #19 Text to display when Mail Flag #4 is found.
  76. '
  77. 'Line #20 Text to display when Mail Flag #5 is found.
  78. '
  79. dim BadEnd as Integer        'Value to trigger program failure message.
  80. dim ChaStr1 as String        'Junk String Variable, re-used at will.
  81. dim ChaStr2 as String        'Junk String Variable, re-used at will.
  82. dim CurCode as Date          'Current Date while in ddmmyyyy format.
  83. dim CurDate as Integer       'Current date coded in DOS format.
  84. dim CurDay as String         'Current Day while code is run.
  85. dim CurMonth as String       'Current Month while code is run.
  86. dim CurYear as String        'Current Year while code is run.
  87. dim FileDos as Word          'File date in DOS code format.
  88. dim FileNm2 as String        'Used to Open assorted files.
  89. dim FileSearch as SearchRec  'Search record array for file info.
  90. dim FileSize as Long         'Current file size.
  91. dim FindQWK as Integer       '"For" loop counter vailable.
  92. dim FindUser as Integer      '"For" loop counter variable.
  93. dim MailProc1 as String      'QWK.CFG #16, Prompt for mail flag #1
  94. dim MailProc2 as String      'QWK.CFG #17, Prompt for mail flag #2
  95. dim MailProc3 as String      'QWK.CFG #18, Prompt for mail flag #3
  96. dim MailProc4 as String      'QWK.CFG #19, Prompt for mail flag #4
  97. dim MailProc5 as String      'QWK.CFG #20, Prompt for mail flag #5
  98. dim MaxAge as Integer        'QWK2HOLD.CFG #8, Maximum # of days packets kept.
  99. dim MaxPacket as Integer     'QWK2HOLD.CFG #7, Maximum allowed QWK packets.
  100. dim MaxSize as Long          'QWK2HOLD.CFG #9, Maximum size of all packets.
  101. dim MaxUser as Integer       'Total number of users in userlist.
  102. dim MsgHd as MessageHeader   'Used to send messages.
  103. dim MsgPlace as Integer      'QWK2HOLD.CFG #10, Conference where messages go.
  104. dim NewFile as String        'New QWK file name.
  105. dim NumInt1 as Integer       'Junk Integer Variable, re-used at will.
  106. dim NumInt2 as Integer       'Junk Integer Variable, re-used at will.
  107. dim OldAge as Integer        'Oldest number of packet days in existance.
  108. dim OldFile as String        'Old QWK file name.
  109. dim P1 as String             'QWK.CFG #11, Prompt #1 Color.
  110. dim P2 as String             'QWK.CFG #12, Prompt #2 Color.
  111. dim P3 as String             'QWK.CFG #13, Prompt #3 Color.
  112. dim P4 as String             'QWK.CFG #14, Prompt #4 Color.
  113. dim QWKAge as Integer        'Current age of the packet in days.
  114. dim QWKFlag as String        'QWK2HOLD.CFG #4, QWK search variable.
  115. dim QWKInbound as String     'QWK2HOLD.CFG #15, Path to mail flag.
  116. dim QWKLocal as String       'Path where Sysop's local QWK packets wind up.
  117. dim QWKRoute as String       'QWK2HOLD.CFG #3, Path to QWK2 mail packets.
  118. dim QWKTotal as Integer      'Total number of QWK packets for user.
  119. dim QWKLeft as Integer       'Total number of QWK packets a user has left.
  120. dim QWKSysop as String       'Path choosen by Sysop for local transfer.
  121. dim SecPro1 as String        'QWK2HOLD.CFG #5, Security Profile #1 restriction.
  122. dim SecPro2 as String        'QWK2HOLD.CFG #6, Security Profile #2 restriction.
  123. dim Size as Long             'Place to store total size of stored packets.
  124. dim UKey as String           'Used to determine user's choice.
  125. 'dim UserRec as UserRecord    'Create temporary array for user record.
  126. dim WCMailRoute as String    'QWK2HOLD.CFG #1, Path where WCMAIL stores packets.
  127. dim WCMailZip as Integer     'QWK2HOLD.CFG #2, File area number used in WCMAIL.
  128. dim QWKDown as String        'Used to determine if user wants to download QWK.
  129. '
  130. 'Time to read in the QWK2HOLD.CFG file.
  131. EnablePages Off ' Disable inbound page till program ends, resets at end.
  132. FileNm2 = ProgPath + "QWK2HOLD.CFG" 'QWK2HOLD.CFG is the configuration file.
  133. If Exists (FileNm2) then              'If QWK2HOLD.CFG exists, get data.
  134.   OPEN FileNm2 for Input as #1        'Open CFG file for reading.
  135.   If Not(local) Then CarrierCheck Off 'Ignore modem till entire file read.
  136.   LockFile (1,0,1)                    'Temporary file lock for multinode use.
  137.   Input #1, WCMailRoute  '#1,  Path where WCMAIL stores packets.
  138.   Input #1, WCMailZip    '#2,  File directory # from MAKEWILD(WCMAIL).
  139.   Input #1, QWKRoute     '#3,  Path to QWK Mail Packets.
  140.   Input #1, QWKFlag      '#4,  User QWK Comment(?) action.
  141.   Input #1, SecPro1      '#5,  Security Exclusion Value #1.
  142.   Input #1, SecPro2      '#6,  Security Exclusion Value #2.
  143.   Input #1, MaxPacket    '#7,  Maximum number of user QWK Packets.
  144.   Input #1, MaxAge       '#8,  Maximum # of days to keep stored packets.
  145.   Input #1, MaxSize      '#9,  Maximum size of storage for user packets.
  146.   Input #1, MsgPlace     '#10, Conference number where messages are to go.
  147.   Input #1, P1           '#11, Prompt color for normal text.
  148.   Input #1, P2           '#12, Prompt color for highlighted text.
  149.   Input #1, P3           '#13, Prompt color for Packet size.
  150.   Input #1, P4           '#14, Prompt color for Alert Messages.
  151.   Input #1, QWKInbound   '#15, Path to inbound mail flag, if mail processing.
  152.   Input #1, MailProc1    '#16, Mail Processing message #1.
  153.   Input #1, MailProc2    '#17, Mail Processing message #2.
  154.   Input #1, MailProc3    '#18, Mail Processing message #3.
  155.   Input #1, MailProc4    '#19, Mail Processing message #4.
  156.   Input #1, MailProc5    '#20, Mail Processing message #5.
  157.   UnlockFile (1,0,1)                  'Remove temporary file lock.
  158.   Close #1                            'Close the CFG file.
  159.   If Not(Local) Then CarrierCheck On  'File read, exit if carrier dropped.
  160. Else 'Go here if no CFG file is found.
  161.   BadEnd = 0 'Set up error message.
  162.   Goto Problem 'No CFG file was found, abort the program.
  163. End If 'End of LOGIN2.CFG input.
  164. If (User.SecLevel = SecPro1) or (User.SecLevel = SecPro2) Then End
  165. 'Validate read QWK2HOLD.CFG file data.
  166. If WCMailRoute = "" Then
  167.   BadEnd = 1: Goto Problem 'WCMail Path missing, QWK2HOLD.CFG LINE #1.
  168. Else 'WCMailroute actually contains something.
  169.   WCMailRoute = Trim(UCase(WCMailRoute)) 'Make it Uppercase & Trim spaces.
  170.   If Mid(WCMailRoute,2,2) <> ":\" Then BadEnd = 1: Goto Problem
  171.   If Right(WCMailRoute,1) <> "\" Then 'Verify path ends in a backslash.
  172.     WCMailRoute = WCMailRoute + "\" 'Slash was added.
  173.   End If 'End of WCMailRoute slash check.
  174. End If 'End of WCMailRoute check.
  175. If QWKRoute = "" Then
  176.   BadEnd = 2: Goto Problem 'QWKRoute missing, QWK2HOLD.CFG LINE #2.
  177. Else 'QWKRoute actually contains something.
  178.   QWKRoute = Trim(UCase(QWKRoute)) 'Make it Uppercase & Trim spaces.
  179.   IF Mid(QWKRoute,2,2) <> ":\" Then BadEnd = 2: Goto Problem
  180.   IF Right(QWKRoute,1) <> "\" Then 'Verify path ends in backslash.
  181.     QWKRoute = QWKRoute + "\" 'Slash was added.
  182.   End If 'End of QWKRoute slash check.
  183. End If 'End of QWKRoute check.
  184. If QWKFlag = "" Then 'Does QWKFlag value exist in  the CFG file.
  185.   BadEnd = 3: Goto Problem 'QWKFlag missing, QWK2HOLD.CFG Line #3.
  186. Else 'QWKFlag actually contains something.
  187.   QWKFlag = UCase(QWKFlag) 'Make it Uppercase.
  188. End If' End of If QWKFlag.
  189. If SecPro1 = "" Then
  190.   SecPro1 = "NO SEC1" 'If no QWK2HOLD.CFG Line #5, set value.
  191. Else 'SecPro1 actually contains something.
  192.   SecPro1 = Trim(UCase(SecPro1)) 'Make it Uppercase & Trim spaces.
  193. End If
  194. If SecPro2 = "" Then
  195.   SecPro2 = "NO SEC2" 'If no QWK2HOLD.CFG Line #6, set value.
  196. Else 'SecPro2 actually contains something.
  197.   SecPro2 = Trim(UCase(SecPro2)) 'Make it Uppercase & Trim spaces.
  198. End If
  199. If QWKInbound = "" Then
  200.   BadEnd = 15: Goto Problem 'QWKInbound missing, QWK2HOLD.CFG LINE #15.
  201. Else 'QWKInbound actually contains something.
  202.   QWKInbound = Trim(UCase(QWKInbound)) 'Make it Uppercase & Trim spaces.
  203.   IF Mid(QWKInbound,2,2) <> ":\" Then BadEnd = 15: Goto Problem
  204.   IF Right(QWKInbound,1) <> "\" Then 'Verify path ends in backslash.
  205.     QWKInbound = QWKInbound + "\" 'Slash was added.
  206.   End If 'End of QWKInbound slash check.
  207. End If 'End of QWKInbound check.
  208. If MaxPacket <= 0 Then MaxPacket = 1 'Minimum value is 1.
  209. If MaxPacket >= 26 Then MaxPacket = 26 'Had to set a limit somewhere.
  210. If MaxAge <= 0 Then MaxAge = 0 'Keep the old packets forever.
  211. If MaxAge >= 365 Then MaxAge = 365 'Maximum life of packets is 1 year.
  212. If MaxSize <= 0 Then MaxSize = 2147483647 'If zero, set limit at highest.
  213. If MaxSize >= 2147483647 Then MaxSize = 2147483647 'Set maximum size limit.
  214. If P1 = "" or Len(P1) <> 2 Then 'Check prompt P1, normal text.
  215.   P1 = "@0E@" 'Set default prompt.
  216. Else P1 = "@" + UCase(P1) + "@"
  217. End If
  218. If P2 = "" or Len(P2) <> 2 Then 'Check prompt P2, highlighted text.
  219.   P2 = "@0F@" 'Set default prompt.
  220. Else P2 = "@" + UCase(P2) + "@"
  221. End If
  222. If P3 = "" or Len(P3) <> 2 Then 'Check prompt P3, Packet sizes.
  223.   P3 = "@0B@" 'Set default prompt.
  224. Else P3 = "@" + UCase(P3) + "@"
  225. End If
  226. If P4 = "" or Len(P4) <> 2 Then 'Check prompt P4, alert text.
  227.   P4 = "@0C@" 'Set default prompt.
  228. Else P4 = "@" + UCase(P4) + "@"
  229. End If
  230. CurrentDate(CurCode) 'Put date into CurDate.
  231. ChaStr1 = FormatDate(CurCode,"ddmmyyyy") 'Convert data into usable String.
  232. CurDay = Left(ChaStr1,2) 'Current Day established, used for CurDate.
  233. CurMonth = Mid(ChaStr1,3,2) 'Current Month established, used for CurDate.
  234. CurYear = Mid(ChaStr1,5,4) 'Current Year established, used for CurDate.
  235. 'Following line codes Wildcat! date to DOS style date for comparisons.
  236. CurDate = ((Val(CurYear)-1980)*512) + (Val(CurMonth)*32)+Val(CurDay)
  237. If WCMailRoute = QWKRoute Then
  238.   ChaStr2 = "QWK2: Line #1 and Line #3 of QWK2HOLD.CFG MUST NOT be the same."
  239.   ActivityLog ChaStr2
  240.   Goto Finished
  241. End If
  242. '>>>----> End of Configuration file and variable setup.
  243.  
  244. '>>>----> Start of main program
  245. QWKTotal = 0
  246. Gosub QWKLook 'Check for existing packets.
  247. MainProg: 'Place program modules return to.
  248.  
  249. CLS
  250. If (User.SecLevel = SecPro1) or (User.SecLevel = SecPro2) Then
  251.   Print P4;"Unfortunately your present Security Level does not allow you"
  252.   Print P4;"the ability to use the QWK program at this time.  Please"
  253.   Print P4;"return after your security Level has been changed."
  254.   WaitEnter : Print: End
  255. End If
  256.  
  257. Print P1;"The operator of this BBS allows callers to temporarily store QWK mail"
  258. Print P1;"packets on the system for up to ";P2;MaxAge;
  259. If MaxAge > 1 then
  260.   Print P1;" days."
  261. Else
  262.   Print P1;" day."
  263. End If
  264. Print
  265. Print P3;"You should only turn this option on if you are using what is known as"
  266. Print P3;"an Offline Mail Reader "P2;"and";P3" you have ";P2;"successfully";P3;" downloaded a QWK mail"
  267. Print P3;"packet from this BBS."
  268. Print
  269. Print P1;"You currently have the Automatic QWK mail option turned ";P2;
  270. NumInt2 = Val(Mid(QWKFlag,9,1))
  271. If Trim(Left(User.Comment(NumInt2),8)) = "QWK2 ON" Then
  272.   Print "ON";P1;"."
  273. Else
  274.   Print "OFF";P1;"."
  275. End If 'End If Trim(Left.
  276.  
  277. NumInt1 = 0'Turn into 1 if a flag was found raised.
  278. If Exists(QWKInbound + "QWK2MA1.FLG") Then
  279.   NumInt1 = 1
  280.   If MailProc1 <> "" Then
  281.     Print P4;MailProc1
  282.   Else
  283.     Print P4;"Mail Flag #1 is flying high at this time."
  284.   End If 'End of message1.
  285. End If 'End of flag1.
  286.  
  287. If Exists(QWKInbound + "QWK2MA2.FLG") Then
  288.   NumInt1 = 1
  289.   If MailProc2 <> "" Then
  290.     Print P4;MailProc2
  291.   Else
  292.     Print P4;"Mail Flag #2 is flying high at this time."
  293.   End If 'End of message2.
  294. End If 'End of flag2.
  295.  
  296. If Exists(QWKInbound + "QWK2MA3.FLG") Then
  297.   NumInt1 = 1
  298.   If MailProc3 <> "" Then
  299.     Print P4;MailProc3
  300.   Else
  301.     Print P4;"Mail Flag #3 is flying high at this time."
  302.   End If 'End of message3.
  303. End If 'End of flag3.
  304.  
  305. If Exists(QWKInbound + "QWK2MA4.FLG") Then
  306.   NumInt1 = 1
  307.   If MailProc4 <> "" Then
  308.     Print P4;MailProc4
  309.   Else
  310.     Print P4;"Mail Flag #4 is flying high at this time."
  311.   End If 'End of message4.
  312. End If 'End of flag4.
  313.  
  314. If Exists(QWKInbound + "QWK2MA5.FLG") Then
  315.   NumInt1 = 1
  316.   If MailProc5 <> "" Then
  317.     Print P4;MailProc5
  318.   Else
  319.     Print P4;"Mail Flag #5 is flying high at this time."
  320.   End If 'End of message5.
  321. End If 'End of flag5.
  322. Print
  323.  
  324. If Trim(Left(User.Comment(Val(Mid(QWKFlag,9,1))),8)) = "QWK2 ON" Then
  325.   If NumInt1 = 1 Then
  326.     Print P1;"If you are still ""Online"" when your QWK Packet(s) are due to be made"
  327.     Print P1;"then yours will be skipped till the next time mail is processed."
  328.     Print
  329.     Delay 3
  330.   End If
  331.   Else 'QWK2 is OFF
  332.     If NumInt1 = 1 Then 'Flag is still raised.
  333.       Delay 3 'Add delay so user can read flag message.
  334.     End If
  335. End If
  336.  
  337.  
  338. If QWKTotal > 0 Then 'Tell the user about existing packets.
  339.   Print P1;"You have ";P2;QWKTotal;P1;" mail packet";
  340.   If QWKTotal > 1 Then
  341.     Print "s";
  342.   End If 'If QWKTotal > 1.
  343.   Print " for a total of ";P3;Int(Size/100);P1;" Kbytes."
  344. Else 'No packets are on hold.
  345.   Print P4;"There are no QWK mail packets on hold for you at this time."
  346. End If 'End if QWKTotal.
  347. Print
  348. Print P3;"You have the following options available at this time."
  349. Print
  350. If User.Xpert = 0 Then 'If a novice then show text.
  351.   Print P1;"[";P2;"C";P1;"]heck on existing mail packets being held for you."
  352.   Print P1;"[";P2;"T";P1;"]urn On\Off the automatic creation of mail packets."
  353.   Print P1;"[";P2;"I";P1;"]nformation about automatic creation of mail packets."
  354.   Print P1;"[";P2;"U";P1;"]pload replies from your QWK mail reader."
  355.   Print P1;"[";P2;"Q";P1;"]uit back to the previous menu."
  356. End If 'Only show above if Novice mode is on.
  357. If User.Xpert = 1 Then 'Regular User.
  358.   Print P1;"[";P2;"C";P1;"]heck, [";P2;"T";P1;"]urn On/Off, [";P2;"I";P1;"]nformation, [";P2;"U";P1;"]pload, [";P2;"Q";P1;"]uit"
  359. End If
  360. Print
  361. ChaStr2 = InputMask(P1+"QWK2: [ C T I U Q ] --> ","X","")
  362. ChaStr2 = Ucase(ChaStr2)
  363. If ChaStr2 = "C" then Gosub QWKLook: Goto MainProg
  364. If ChaStr2 = "T" then Gosub QWKNow: Goto MainProg
  365. If ChaStr2 = "I" then Gosub QWKMore: Goto MainProg
  366. If ChaStr2 = "U" then Gosub QWKUpload: Goto MainProg
  367. If ChaStr2 = "Q" then End
  368. Goto MainProg
  369. 'If ChaStr2 = "R" or anything else then end this program.
  370. End 'End of main program
  371. '>>>----> End of Main program.
  372.  
  373. '>>>----> Start of QWKNow subroutine.
  374. QWKNow:
  375. Print
  376. NumInt2 = Val(Mid(QWKFlag,9,1))
  377. If  Trim(Left(User.Comment(NumInt2),8)) = "QWK2 ON" Then
  378.   Print P1;"You account has the automatic creation of mail packets turned ";P2;"On."
  379. Else
  380.   Print P1;"Your account has the automatic creation of mail packets turned ";P2;"Off."
  381. End If 'End of above If.
  382. Print
  383. ChaStr1 =InputMask(P1+"Do you want mail packets premade for you?","Y")
  384. NumInt2 = Val(Mid(QWKFlag,9,1))
  385. If UCase(ChaStr1) = "Y" Then
  386.   User.Comment(NumInt2) = "QWK2 ON  "  'Yes reply
  387.   Print P1;"Automatic QWK making has been turned ";P2;"on";P1;"."
  388. Else
  389.   User.Comment(NumInt2) = "QWK2 OFF "  'If Answer was No
  390.   Print P1;"Automatic QWK making has been turned ";P2;"off";P1;"."
  391. End If 'End of If InputYesNo.
  392. WaitEnter
  393. Return
  394. '>>>----> End of QWKNow subroutine.
  395.  
  396. '>>>----> Start of QWKMore subroutine.
  397. QWKMore:
  398. ChaStr2 = ProgPath + "QWK2HOLD.TXT"
  399. If Exists(ChaStr2) Then
  400.   Print P1
  401.   DisplayTextFile(ChaStr2)
  402. Else
  403.   Print P2;"QWK2HOLD";P1;", created by James Mardis (Fidonet 1:322/746)"
  404.   Print
  405.   Print
  406.   Print P1;"Your Sysop has activated the option that will allow callers who are"
  407.   Print P1;"using what is known as a ""Offline Mail Reader"" to automatically"
  408.   Print P1;"have QWK mail packets made for them after inbound mail is processed."
  409.   Print
  410.   Print P1;"Programs of this type allow a caller to download any mail they have"
  411.   Print P1;"in one short call to the BBS.  They then can take all the time they"
  412.   Print P1;"want to read and reply to the mail with out having to use up thier"
  413.   Print P1;"alloted time on the BBS.  When they have finished with any replies"
  414.   Print P1;"they call the BBS back and upload all of them in one quick upload."
  415.   WaitEnter
  416.   Print
  417.   Print P1;"Your Sysop has granted you the ability to have QWK mail packets"
  418.   Print P1;"made automatically for you.  These QWK mail packets can only be"
  419.   Print P1;"left on the system for ";P2;MaxAge;P1;
  420.   If MaxAge > 1 then
  421.     Print P1;" days."
  422.   Else
  423.     Print P1;"day."
  424.   End If 'End of If MaxAge > 1.
  425.   Print
  426.   Print P1;"If you leave QWK mail on the system longer than this limit the"
  427.   Print P1;"system will turn off this option for your account.  You will be"
  428.   Print P1;"sent an automatic notice advising you that you have over age mail"
  429.   Print P1;"packets.  15 days after the warning ";P2;"all";P1;" of your remaining QWK"
  430.   Print P1;"mail packets will be deleted."
  431.   Print
  432.   Print P1;"You can later turn this option back on if you so desire."
  433.   WaitEnter
  434.   Print
  435.   Print P1;"Your system administrator has set the following values for this program:"
  436.   Print
  437.   Print P1;"Warning message will be sent if packets are older then [";P2;MaxAge;P1;"] ";
  438.   If MaxAge > 1 Then
  439.     Print P1;"days."
  440.   Else
  441.     Print P1;"day."
  442.   End If 'End of MaxAge > 1.
  443.   Print P1;"Maximum number of QWK Packets in storage, [";P2;MaxPacket;P1;"] at one time."
  444.   Print P1;"If the total size of existing packets exceed [";P2;Int(MaxSize/100);P1;"] Kbytes"
  445.   Print P1;"then no new packets will be made."
  446.   Print
  447. End If
  448. WaitEnter
  449. Return
  450. '>>>----> End of QWKMore subroutine.
  451.  
  452. '>>>----> Start of QWKUpload
  453. QWKUpload:
  454.  
  455. If Trim(Left(User.Comment(NumInt2),8)) = "QWK2 ON" Then
  456.   PushCommand "U"
  457.   ChaStr2 = "WCMAIL.EXE ":Shell ChaStr2
  458. Else
  459.   Print
  460.   Print P1;"This menu option is only active if you have the Automatic"
  461.   Print P1;"creation of QWK packets turned on."
  462.   Print
  463.   WaitEnter
  464. End If
  465. Return
  466. '>>>----> End of QWKUpload
  467.  
  468. '>>>----> Start QWKLook subroutine.
  469. QWKLook:
  470. 'Do clean up in case packets don't start with A or are out of sequence.
  471. NumInt1 = 0
  472. FindQWK = 0
  473. Do While FindQWK < MaxPacket
  474.   NewFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(NumInt1 + 65)
  475.   OldFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
  476.   If Exists(OldFile) Then 'OldFile already exists so go add one and go on.
  477.     FindQWK = FindQWK + 1
  478.     NumInt1 = NumInt1 + 1
  479.     If OldFile <> NewFile Then 'OldFile exists but does it match Newfile
  480.       Name OldFile as NewFile' Nope, rename Oldfile to fill gap.
  481.     End If 'End of If Oldfile <> Newfile
  482.   ELSE 'Oldfile was not found, increment and go thru loop again.
  483.     FindQWK = FindQWK + 1
  484.   End If 'End of If Exists(Oldfile)
  485. Loop
  486.  
  487. 'Main section of QWKLook begins here.
  488. Size = 0
  489. NewFile = QWKRoute + Str(User.UserID) + ".QWA"
  490. OldFile = WCMailRoute + Str(User.UserID) + ".QWK"
  491. If Exists(NewFile) or Exists(OldFile) Then
  492.   FindQWK = 0
  493.   Print
  494.   Print P1;"At least one mail packet is on hold, looking for others."
  495.   Print
  496.   Print P1;"  FileName      Size     Age";P2
  497.   Do While FindQWK < MaxPacket + 1
  498.     Newfile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
  499.     If Exists(NewFile) Then 'Checking for existing stored packet.
  500.       FindFirst(NewFile,0,FileSearch)
  501.       FileSize=FileSearch.Size
  502.       FileDos=FileSearch.DosDate
  503.       Size = Size + FileSearch.Size
  504.       Print P2;LeftPad(UCase(Trim(MakeWild.PacketId)) + ".QW" + Chr(FindQWK + 65),8);
  505.       Print P3;LeftPad(Str(Int(FileSearch.Size/100)),8);"K";
  506.       Print P2;LeftPad(Str(CurDate - FileDos),5);
  507.       If CurDate - FileDos = 1 Then
  508.         Print P1;" Day"
  509.       Else 'Part of If CurDate - FileDos = 1
  510.         If CurDate - FileDos = 0 Then
  511.           Print P1;" Today"
  512.         Else 'Part of If CurDate - FileDos = 0
  513.           Print P1;" Days"
  514.         End If 'End if age = 0
  515.       End If 'End of If age = 1
  516.   Else 'Ran out of files to check in QWK2.
  517.     Exit Do 'Early escape out of the Do While loop.
  518.   End If 'Done checking for existing packet.
  519.   FindQWK = FindQWK + 1
  520.   If FindQWK > QWKTotal Then 'Correct total if needed.
  521.     QWKTotal = QWKTotal + 1'Existing packet count incremented.
  522.   End If
  523.   Loop' Run thru the Do While loop again.
  524.   'Look for orphaned QWK packets the user may have made with WCMAIL.
  525.   ChaStr1 = QWKRoute + Str(User.UserID)'Partial Newfile.
  526.   If QWKTotal >= 26 then 'If number of packets already at limit.
  527.     NumInt1 = 48' Make packet end in zero.
  528.   Else 'Go look for more packets.
  529.     NumInt1 = QWKTotal + 1'Otherwise make it next letter in alphabet.
  530.   End If 'Done determining new packets for NewFile construction.
  531.   NewFile = ChaStr1 + ".QW" + Chr(NumInt1) 'Newfile variable.
  532.   OldFile = WCMailRoute + Str(User.UserID) + ".QWK" 'OldFile Variable.
  533.   If Exists(OldFile) Then 'Get ready to relocate WCMAIL QWK Packet.
  534.     CopyFile(OldFile,NewFile) 'Copy WCMAIL QWK packet to storage.
  535.     ChaStr1 = Str(User.UserID) + ".QWK"
  536.     DeleteFile(ChaStr1,WCMailZip,1) 'Delete old QWK file from disk & records.
  537.     QWKTotal = QWKTotal + 1'Increment total number of stored packets.
  538.     FindFirst(NewFile,0,FileSearch) 'Establish FileSearch variable.
  539.     FileSize=FileSearch.Size'Determine packet file size.
  540.     Size = Size + FileSearch.Size 'Increment size of stored packets.
  541.     Print LeftPad(FileSearch.Name,12) + LeftPad(Str(Int(FileSearch.Size/100)),14)
  542.   End If 'WCMail Packet has been moved to storage.
  543. ELSE 'No packets found in storage.
  544. Return
  545. End If 'Finished loading variables and displaying any existing packets.
  546. Print P1;"You have ";P2;QWKTotal;P1;" mail packet";
  547. If QWKTotal > 1 Then Print "s";
  548. Print" for a total of ";P3;Int(Size/100);P1;" Kbytes."
  549. If QWKTotal > 0 Then
  550.   Print P1;"The following choices are available for your use:"
  551.   Print P1;"[";P2;"A";P1;"]ll packets downloaded now and continue."
  552.   Print P1;"[";P2;"D";P1;"]ownload all packets now and log off of the BBS."
  553.   Print P1;"[";P2;"F";P1;"]irst, download only first packet and continue."
  554.   Print P1;"[";P2;"N";P1;"]o packets downloaded at this time, continue with BBS."
  555.   Print
  556.   ChaStr2 = InputMask(P1+"Choose Download ["+P2+"A"+P1+"]ll, ["+P2+"D"+P1+"]ownload & Goodbye, ["+P2+"F"+P1+"]irst, or ["+P2+"N"+P1+"]one ","X","A")
  557.   ChaStr2 = UCase(ChaStr2)
  558.   UKey = ChaStr2 'Set Ukey value from user's input.
  559.   If Chastr2 = "N" Then Print: Return'Abort out of here.
  560.   If ChaStr2 = "A" Then'Going for the whole hog.
  561.     If QWKTotal > 1 Then
  562.       Print P1;"The mail packets will be sent in sequence, one right after the other."
  563.       Print P3;"There will be a short pause between packets, please be patient."
  564.     End If 'End of If QWKTotal.
  565.   End If 'End checking for All response.
  566. End If 'End of If QWKTotal > 1
  567.  
  568. If (Local) Then
  569.   Print
  570.   Print P1;"Enter the path where you want your mail packets to wind up."
  571.   Print P1;"Please use the following format shown in example: ";P2;"C:\READER";P1;"."
  572.   QWKSysop = InputMask("-->","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")'Get local Sysop mail path.
  573.   If QWKSysop = "" Then Return
  574.  
  575.   QWKSysop = Trim(UCase(QWKSysop)) 'Make it Uppercase & trim spaces.
  576.   IF Mid(QWKSysop,2,2) <> ":\" Then BadEnd = 21: Gosub Problem
  577.   IF Right(QWKSysop,1) = "\" Then 'Verify no ending backslash.
  578.     NumInt1 = Len(QWKSysop) - 1
  579.     QWKSysop = Left(QWKSysop,NumInt1) 'Slash was removed
  580.   End If 'End of QWKSysop slash check.
  581. End If 'End of If (Local)
  582.  
  583. Print
  584. If UKey <> "A" Then
  585.   ChaStr2 = InputMask(P1+"Hit the Enter key to begin the file transfer or ["+P2+"A"+P1+"] to abort.","X")
  586.   If UCase(Left(ChaStr2,1)) = "A" then UKey = "": Return
  587. End If 'If UKey <> "A"
  588. QWKLeft = QWKTotal 'Load in how many packets a user needs to download.
  589. For FindQWK = 0 to QWKTotal - 1
  590.   OldFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
  591.   ChaStr2 = TempPath
  592.   NewFile = ChaStr2 + UCase(Trim(MakeWild.PacketId)) + ".QW" + Chr(FindQWK + 65)
  593.   If (Local) then
  594.     If Len(QWKSysop) <= 20 Then PushCommand QWKSysop 'PushCommand 20 char limit.
  595.   End If'End of Local check.
  596.   CopyFile (OldFile,NewFile)' Move to temp. Can't use Name -> drive letter.
  597.   Del OldFile
  598.   If SendFile(NewFile) Then 'Goto else option if not a good send.
  599.     Del NewFile 'Delete file that was sucessfully sent.
  600.     ActivityLog "QWK2: File " + NewFile + " was downloaded successfully."
  601.     QWKLeft = QWKLeft - 1
  602.   Else
  603.     Print P4;" Mail transfer failed.";P1
  604.     CopyFile (NewFile,OldFile)' Rename and put file back in storage.
  605.     Del NewFile
  606.     ActivityLog "QWK2: " + NewFile + " was not downloaded successfully."
  607.     Exit For
  608.   End If 'End of Sendfile.
  609.   If Ukey = "F" Then
  610.     Print
  611.     ChaStr2 =InputMask(P1+"["+P2+"N"+P1+"]ext File, ["+P2+"S"+P1+"]top Downloading ","X","N")
  612.     If UCase(Left(ChaStr2,1)) = "S" Then
  613.       Exit For
  614.     End If'End of "S" check.
  615.   End If 'End of "F" check.
  616. Next FindQWK
  617.  
  618. 'Final Clean up
  619. If Not(QWKLeft = QWKTotal) Then 'At least one mail packet was transferred.
  620.    NumInt1 = QWKTotal - QWKLeft' Determine how many are left in storage.
  621.    QWKTotal = QWKLeft 'Correct total value now cause something was downloaded.
  622.    For FindQWK = 0 to QWKLeft - 1
  623.      NewFile = Trim(QWKRoute) + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
  624.      OldFile = Trim(QWKRoute) + Str(User.UserID) + ".QW" + Chr(NumInt1 + 65)
  625.      Name OldFile As NewFile'Move names of left over packets to top.
  626.      NumInt1 = NumInt1 + 1
  627.    Next FindQWK
  628. End If
  629.  
  630. 'Load QWK2 value into user file.
  631. NumInt2 = Val(Mid(QWKFlag,9,1))
  632. ChaStr1 = Pad( UCase( Left( User.Comment(NumInt2),9) ) ,9) 'Load QWK ON/OFF.
  633. User.Comment(Val(Mid(QWKFlag,9,1))) = ChaStr1 'Updated Values.
  634. If UKey = "D" Then 'Quit BBS call when done.
  635.   Goodbye True 'Log off user.
  636. End If 'If UKey = "D".
  637. Return ' Return to mail program.
  638. '>>>----> End of QWKLook subroutine
  639.  
  640. '>>>----> Start of Problem Goto
  641. Problem: 'Come here if there is an error needing attention.
  642. 'Note: (Problem:) is used as a GoSub or a Goto depending on BadEnd #.
  643.  
  644. 'Reserve BadEnd 1 - 20 for .CFG file checking
  645. If BadEnd >= 0 and BadEnd <=19 Then 'Something wrong with configuation file.
  646.   CLS
  647.   Print
  648.   If BadEnd = 0  Then
  649.     Print P4;"The QWK2HOLD.CFG file was not located." 'Where is it.
  650.   Else
  651.     Print P1;"Line [";P2;BadEnd;P1;"] of the ";P2;"QWK2HOLD.CFG";P1;" has a problem." 'What line is bad.
  652.   End If 'End If BadEnd = 0
  653.   Print
  654.   Print P1;"The current values of your ";P2;"QWK2HOLD.CFG";P1;" file are";P2;":"
  655.   Print P1;"Line  #1 = [";P2;WCMailRoute;P1;"]"
  656.   Print P1;"Line  #2 = [";P2;WCMailZip;P1;"]"
  657.   Print P1;"Line  #3 = [";P2;QWKRoute;P1;"]"
  658.   Print P1;"Line  #4 = [";P2;QWKFlag;P1;"]"
  659.   Print P1;"Line  #5 = [";P2;SecPro1;P1;"]"
  660.   Print P1;"Line  #6 = [";P2;SecPro2;P1;"]"
  661.   Print P1;"Line  #7 = [";P2;MaxPacket;P1;"]"
  662.   Print P1;"Line  #8 = [";P2;MaxAge;P1;"]"
  663.   Print P1;"Line  #9 = [";P2;MaxSize;P1;"]"
  664.   Print P1;"Line #10 = [";P2;MsgPlace;P1;"]"
  665.   Print P1;"Line #11 = [";P2;Mid(P1,2,2);P1;"]"
  666.   Print P1;"Line #12 = [";P2;Mid(P2,2,2);P1;"]"
  667.   Print P1;"Line #13 = [";P2;Mid(P3,2,2);P1;"]"
  668.   Print P1;"Line #14 = [";P2;Mid(P4,2,2);P1;"]"
  669.   Print P1;"Line #15 = [";P2;QWKInbound;P1;"]"
  670.   Print
  671.   Print P1;"This program will terminate after a 60 seconds pause."
  672.   Delay 60
  673. End If 'End Error #1 - 19.
  674.  
  675. If BadEnd = 20 Then
  676.   Print
  677.   Print P1;"Your input did not make sense, you may not download your QWK"
  678.   Print P1;"packet at this time."
  679.   Print
  680.   WaitEnter
  681.   Return
  682. End If
  683.  
  684. If BadEnd = 21 Then
  685.   Print
  686.   Print P1;"The path you supplied could not be located.  Mail packet"
  687.   Print P1;"transfer can not take place at this time."
  688.   Print
  689.   WaitEnter
  690.   Return
  691. End If
  692.  
  693. If BadEnd = 22 Then
  694.   ChaStr2 = "QWK2: User does not have QWK checking turned on."
  695.   ActivityLog ChaStr2
  696. End If
  697.  
  698. If BadEnd = 23 Then
  699.   ChaStr2 = "QWK2: User did not meet security requirements for QWK2."
  700.   ActivityLog ChaStr2
  701. End If
  702. Goto Finished'If you wind up here something is wrong with the program.
  703. '>>>----> End of Problem Goto
  704.  
  705. '>>>----> Come here at the end of the program.
  706. Finished:
  707. ChaStr2 = "QWK2: Program has ended at this time."
  708. ActivityLog ChaStr2
  709. End